home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tcl7.4 / tests / env.test < prev    next >
Encoding:
Text File  |  1994-12-18  |  2.8 KB  |  109 lines
  1. # Commands covered:  none (tests environment variable implementation)
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1991-1993 The Regents of the University of California.
  8. # Copyright (c) 1994 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # @(#) env.test 1.8 94/12/17 16:19:50
  14.  
  15. if {[string compare test [info procs test]] == 1} then {source defs}
  16.  
  17. # If there is no "printenv" program on this system, then it's just too
  18. # much trouble to run this test (can't necessarily run csh to get the
  19. # environment:  on some systems it barfs if there isn't a minimum set
  20. # predefined environment variables.  Also, printenv returns a non-zero
  21. # status on some systems, so read the environment using a procedure
  22. # that catches errors.
  23.  
  24. set printenv {}
  25. if [info exists env(PATH)] {
  26.     set dirs [split $env(PATH) :]
  27. } else {
  28.     set dirs {/bin /usr/bin /usr/ucb /usr/local /usr/public /usr/etc}
  29. }
  30. foreach i $dirs {
  31.     if [file executable $i/printenv] {
  32.     # The following hack is needed because of weirdness with
  33.     # environment variables in symbolic lines on Apollos (?!#?).
  34.     if ![catch {exec sh -c "cd $i; pwd"} x] {
  35.         set printenv $x/printenv
  36.     } else {
  37.         set printenv $i/printenv
  38.     }
  39.     break
  40.     }
  41. }
  42. if {$printenv == ""} {
  43.     puts stdout "Skipping env tests:  need \"printenv\" to read environment."
  44.     return ""
  45. }
  46. proc getenv {} {
  47.     global printenv
  48.     catch {exec $printenv} out
  49.     if {$out == "child process exited abnormally"} {
  50.     set out {}
  51.     }
  52.     return $out
  53. }
  54.  
  55. # Save the current environment variables at the start of the test.
  56.  
  57. foreach name [array names env] {
  58.     set env2($name) $env($name)
  59.     unset env($name)
  60. }
  61.  
  62. test env-1.1 {adding environment variables} {
  63.     getenv
  64. } {}
  65.  
  66. set env(NAME1) "test string"
  67. test env-1.2 {adding environment variables} {
  68.     getenv
  69. } {NAME1=test string}
  70.  
  71. set env(NAME2) "more"
  72. test env-1.3 {adding environment variables} {
  73.     getenv
  74. } {NAME1=test string
  75. NAME2=more}
  76.  
  77. set env(XYZZY) "garbage"
  78. test env-1.4 {adding environment variables} {
  79.     getenv
  80. } {NAME1=test string
  81. NAME2=more
  82. XYZZY=garbage}
  83.  
  84. set env(NAME2) "new value"
  85. test env-2.1 {changing environment variables} {
  86.     getenv
  87. } {NAME1=test string
  88. NAME2=new value
  89. XYZZY=garbage}
  90.  
  91. unset env(NAME2)
  92. test env-3.1 {unsetting environment variables} {
  93.     getenv
  94. } {NAME1=test string
  95. XYZZY=garbage}
  96. unset env(NAME1)
  97. test env-3.2 {unsetting environment variables} {
  98.     getenv
  99. } {XYZZY=garbage}
  100.  
  101. # Restore the environment variables at the end of the test.
  102.  
  103. foreach name [array names env] {
  104.     unset env($name)
  105. }
  106. foreach name [array names env2] {
  107.     set env($name) $env2($name)
  108. }
  109.